home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS03.ADF / ABasiCprogs / Gomoku.bas < prev    next >
BASIC Source File  |  1986-04-02  |  5KB  |  161 lines
  1. 200   REM - By Gary D. Walborn
  2. 300   REM - November 2, 1985
  3. 400   REM - You may freely use and distribute this program without profit.
  4. 500   REM - Please do not remove these heading lines
  5. 1000  screen 1,3
  6. 1010  player%=1:computer%=2:empty%=0
  7. 1020  dim a%(10,10)
  8. 1030  size%=10:zero%=0:one%=1
  9. 1100  for r=0 to 8:read reg%(r):next r
  10. 1200  window 2,10,10,500,80,"Instructions"
  11. 1300  cmd #2
  12. 1400  print "    This game is played on a 10 x 10 grid.  During the"
  13. 1500  print "play, you may cover one grid intersection with a marker"
  14. 1600  print "The object of the game is to place 5 markers in a row --"
  15. 1700  print "5 adjacent markers in a row -- horizontally, vertically, "
  16. 1800  print "horizontally, vertically, or along either diagonal."
  17. 1850  print "Place the cursor and click the mouse to move."
  18. 1900  print "If I prevent you from placing 5 markers in a row, I win!"
  19. 2000  cmd #0
  20. 2100  a$="Read the instruction. Then press enter":gosub 11500
  21. 2200  input a$
  22. 2300  gosub 6800:gosub 7200
  23. 2600  for i%=one% to size%:for j%=one% to size%:a%(i%,j%)=empty%:next j%:next i%
  24. 2700  a$="We alter nate moves. You go first!":gosub 11500
  25. 2800  a$="Your move":gosub 11500
  26. 2900  gosub 10700
  27. 3000  if i%=-1 then 6500
  28. 3100  x%=i%:y%=j%:gosub 5600:if l%=player% then 3400
  29. 3200  a$="That is not a leegal move. Try again!":gosub 11500
  30. 3300  goto 2800
  31. 3400  if a%(i%,j%)=empty% then 3700
  32. 3500  a$="That square is occupied. Try again!":gosub 11500
  33. 3600  goto 2900
  34. 3700  a%(i%,j%)=player%:gosub 9600
  35. 3800  p%=player%:gosub 11900:if win%=one% then 6200
  36. 3900  Rem *** Computer tries intelligent move ***
  37. 4000  For e%=-1 to 1:for f%=-1 to 1: if e%+f%-e%*f%=0 then 4400
  38. 4100  x%=i%+e%:y%=j%+f%:gosub 5600
  39. 4200  if l%=empty% then 4400
  40. 4300  if a%(x%,y%)=player% then 5200
  41. 4400  next f%:next e%
  42. 4500  Rem ***Computer tries random move***
  43. 4600  x%=int(size%*rnd(1))+1:y%=int(size%*rnd(1))+1:gosub 5600:if l%=0 then 4600
  44. 4700  if a%(x%,y%)<>empty% then 4600
  45. 4800  a%(x%,y%)=computer%:i%=x%:j%=y%:gosub 9600
  46. 4900  p%=computer%:gosub 11900:if win%=one% then 6400
  47. 5000  gosub 15700:if win%=one% then 6400
  48. 5100  goto 2800
  49. 5200  x%=i%-e%:y%=j%-f%:gosub 5600
  50. 5300  if l%=zero% then 4600
  51. 5400  goto 4700
  52. 5500  Rem See if move is legal
  53. 5600  l%=one%:if x%<player% then 6100
  54. 5700  if x%>size% then 6100
  55. 5800  if y%<one% then 6100
  56. 5900  if y%>size% then 6100
  57. 6000  return
  58. 6100  l%=zero%:return
  59. 6200  a$="You win! That was a nice move!":gosub 11500
  60. 6300  goto 6500
  61. 6400  a$="I win! Better luck next time!":gosub 11500
  62. 6500  a$="Thank you for the game!":gosub 11500
  63. 6600  a$="Please click the mouse to continue.":gosub 11500
  64. 6650  gosub 10700
  65. 6700  close 1:close 2:end
  66. 6800  window 1,10,10,400,150,"Gomoko by Gary D. Walborn"
  67. 6900  cmd #1:ask window savew%,saveh%
  68. 7000  cmd #0
  69. 7100  return
  70. 7200  cmd #1:a$="Just a moment.":gosub 11500
  71. 7300  ask window width%,height%
  72. 7400  savew%=width%:saveh%=height%
  73. 7500  pena 2
  74. 7600  box (0,0;width%,height%),1
  75. 7700  pena 5
  76. 7800  dx=width%/12
  77. 7900  dy=height%/12
  78. 8000  for x=dx+dx/2 to 11*dx step dx
  79. 8100  draw (x,0 to x,height%)
  80. 8200  next x
  81. 8300  for y=dy+dy/2 to 11*dy step dy
  82. 8400  draw (0,y to width%,y)
  83. 8500  next y
  84. 8600  for i%=one% to size%:for j%=one% to size%
  85. 8700  tx%=i%*dx+dx/2:ty%=j%*dy+dy/2
  86. 8800  peno 1
  87. 8900  if a%(i%,j%)<>empty% then circle (tx%,ty%),dx/8
  88. 9000  if a%(i%,j%)=player% then pena 0
  89. 9100  if a%(i%,j%)=computer% then pena 3
  90. 9200  if a%(i%,j%)<>empty% then paint (tx%,ty%)
  91. 9300  next j%:next i%
  92. 9400  cmd #0
  93. 9500  return
  94. 9600  cmd #1
  95. 9700  ask window width%,height%
  96. 9800  if height%<>saveh% or width%<>savew% goto 7200
  97. 9900  tx%=i%*dx+dx/2:ty%=j%*dy+dy/2
  98. 10000 peno 1
  99. 10100 circle (tx%,ty%),dx/8
  100. 10200 if a%(i%,j%)=player% then pena 0
  101. 10300 if a%(i%,j%)=computer% then pena 3
  102. 10400 paint (tx%,ty%)
  103. 10500 cmd #0
  104. 10600 return
  105. 10700 cmd #1:ask mouse mx%,my%,mb%
  106. 10800 ask window width%,height%
  107. 10900 if width%<>savew% or height%<>saveh% then gosub 7200
  108. 11000 if mb%=empty% then 10700
  109. 11100 if mx%>width% or my%>height% then 10700
  110. 11200 i%=int(mx%/dx):j%=int(my%/dy)
  111. 11300 cmd #0
  112. 11400 return
  113. 11500 b$=translate$(a$)
  114. 11600 b%=narrate(b$,reg%())
  115. 11700 return
  116. 11800 data 130,0,150,0,22200,64,10,1,0
  117. 11900 win%=0
  118. 12000 for ty%=1 to size%
  119. 12100 c%=empty%
  120. 12200 for tx%=1 to size%
  121. 12300 if a%(tx%,ty%)=p% then c%=c%+one% else c%=0
  122. 12400 if c%=5 then win%=one%
  123. 12500 next tx%:next ty%
  124. 12600 for tx%=one% to size%
  125. 12700 c%=zero%
  126. 12800 for ty%=one% to size%
  127. 12900 if a%(tx%,ty%)=p% then c%=c%+one% else c%=zero%
  128. 13000 if c%=5 then win%=one%
  129. 13100 next ty%:next tx%
  130. 13200 for tx%=1 to 5
  131. 13300 for ty%=1 to 5
  132. 13400 d%=size%-tx%
  133. 13500 maxd%=size%-ty%
  134. 13600 if d%<maxd% then maxd%=d%
  135. 13700 maxd%=maxd%-one%
  136. 13800 c%=zero%
  137. 13900 if a%(tx%,ty%)<>p% then 14400
  138. 14000 for d%=zero% to maxd%
  139. 14100 if a%(tx%+d%,ty%+d%)=p% then c%=c%+one% else c%=zero%
  140. 14200 if c%=5 then win%=one%
  141. 14300 next d%
  142. 14400 next ty%:next tx%
  143. 14500 for tx%=5 to 10
  144. 14600 for ty%=0 to 5
  145. 14700 if tx%<10-ty% then maxd%=tx% else maxd%=10-ty%
  146. 14800 maxd%=maxd%-one%
  147. 14900 c%=zero%
  148. 15000 if a%(tx%,ty%)<>p% then 15500
  149. 15100 for d%=zero% to maxd%
  150. 15200 if a%(tx%-d%,ty%+d%)=p% then c%=c%+one% else c%=zero%
  151. 15300 if c%=5 then win% = one%
  152. 15400 next d%
  153. 15500 next ty%:next tx%
  154. 15600 return
  155. 15700 win%=one%
  156. 15800 for tx%=one% to size%
  157. 15900 for ty%=one% to size%
  158. 16000 if a%(tx%,ty%)=empty% then win%=zero%
  159. 16100 next ty%:next tx%
  160. 16200 return
  161.